home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / gcc263-inclib.lha / gnu / geninline / conv.p next >
Text File  |  1994-09-22  |  16KB  |  494 lines
  1. #!/c/perl
  2. # convert pair of clib/proto header and fd file into an inline header
  3. #
  4. # (C) 1992 by Markus Wild
  5. # <wild@nessie.cs.id.ethz.ch> or <wild@amiga.physik.unizh.ch>
  6. #
  7. # this tool requires PERL.
  8. #
  9. # 1.1   92-jun-04    now handles double arguments
  10. # 1.2   92-jul-02    generates stdarg and alias macros. 
  11. # 1.3   92-jul-08    makes use of 2.2.2's new "memory" clobbering, and no longer
  12. #            emits those *(char*)a0=*(char*)a0 hacks.
  13. #       94-sep-21    updated for AmigaOS 3.1 (G.Nikl)
  14. #
  15. # TODO: handle full ANSI declarations, 
  16. #       eg. void qsort (void *, size_t, size_t, int (*)(const void *, const void *));
  17. #       Currently omit the declaration of the arguments of the function pointers,
  18. #       ie. in this example, use
  19. #       void qsort (void *, size_t, size_t, int (*)());
  20. #
  21. #       perform register allocation in those cases where a4 or a5 is used
  22. #       automatically.
  23. #
  24.  
  25. $#ARGV == 1 || die "Usage: $0 proto-file fd-file\n";
  26.  
  27. open(PROTO_F, $ARGV[0]) || die "Can't open $ARGV[0], $!";
  28. open(FD_F, $ARGV[1]) || die "Can't open $ARGV[1], $!";
  29.  
  30. # set the input record separator to ; to be able to parse multiline 
  31. # declarations. This could get us into troubles with comments.. we will see
  32. $/=";";
  33.  
  34. p_line: while (<PROTO_F>) {
  35. #print "0: ",$_,"\n";
  36.  
  37.   # skip proprocessor statements and comments
  38.   s/\n+/\n/g;
  39. #print "01: ", $_, "\n";
  40.   s/(#.*\n)+//g;
  41. #print "02: ", $_, "\n";
  42.   s/\/\*([^\*]*\*+)*\///g;
  43. #print "03: ", $_, "\n";
  44.   s/^([^\n\(]+\n)+//g;
  45.   
  46.   next if $_ eq "";
  47.   next unless /\(/;
  48.   
  49.   # suppose this is a function declaration
  50.   # this `little' pattern filters out the return type and the argument
  51.   # line. The return type is quite tricky, since it can be a multi word
  52.   # type (like struct foo *), and we shouldn't overwrite the function
  53.   # name by matching against the return type... this seems to work, although
  54.   # I'm not completly sure it does in all cases.
  55.  
  56. #print "1: ",$_;
  57.   s/\(\s*\*/\(\*/g;
  58. #print "2: ",$_;
  59.   s/\s+(\([^\*])/\(\1/g;
  60. #print "3: ",$_;
  61.   /((\w+\s)*\w+\W+)(\w+)\((([^,\(\)]+|\([^\)]*\)|,|\s)*)\)([^;]*);/;
  62.  
  63.   # %result_tab contains the type part written before the function name
  64.   $result_tab{$3} = $1;
  65.   # %result_tab_end contains the type part written after the closing parenthesis
  66.   chop $6;
  67.   $result_tab_end{$3} = $6;
  68.   # %arg_type_tab contains (later only) the type information for the arguments
  69.   $arg_type_tab{$3} = $4;
  70.   
  71.   # compress the types, throw out not needed whitespace as much as we can
  72.   $result_tab{$3} =~ s/\s+/ /g;
  73.   $result_tab_end{$3} =~ s/\s+/ /g;
  74.   $result_tab_end{$3} =~ s/(\s+$)|(^\s+)//g;
  75.   $arg_type_tab{$3} =~ s/\s+/ /g;
  76.   $arg_type_tab{$3} =~ s/\s*,\s*/,/g;
  77.   $arg_type_tab{$3} =~ s/(\s+$)|(^\s+)//g;
  78. }
  79.  
  80. # now parse the given fd file
  81.  
  82. # reset input record separator to newline for fd file
  83. $/="\n";
  84. $bias = 0;
  85. $private = 0;
  86. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($lib_base_name = "${2}Base");
  87. $lib_base_name[0] =~ tr/[a-z]/[A-Z]/;
  88.  
  89. f_line: while (<FD_F>) {
  90.   # strip terminating new line
  91.   chop;
  92.  
  93.   # get rid of comments
  94.   /^\*/ && next f_line;
  95.  
  96.   # parse commands
  97.   /^##base _(\w+)/    && ($lib_base_name = $1) && next f_line;
  98.   /^##bias (\d+)/    && ($bias = $1)         && next f_line;
  99.   /^##public/        && (($private = 0), 1)     && next f_line;
  100.   /^##private/        && ($private = 1)     && next f_line;
  101.   last if /^##end/;
  102.  
  103.   # parse function
  104.   /^(\w+)\(([^\)]*)\)\s*\(([^\)]*)\)/;
  105.   
  106.   $reg_tab{$1} = $3;
  107.   $arg_name_tab{$1} = $2;
  108.   $bias_tab{$1} = $bias;
  109.  
  110.   $bias += 6;
  111. }
  112.  
  113. %base_types = (
  114.   'AmigaGuideBase',    'struct Library *',
  115.   'AslBase',        'struct Library *',
  116.   'BattClockBase',    'struct Node *',
  117.   'BattMemBase',    'struct Node *',
  118.   'BulletBase',        'struct Library *',
  119.   'ColorWheelBase',    'struct Library *',
  120.   'CardResource',    'struct Node *',
  121.   'CxBase',        'struct Library *',
  122.   'ConsoleDevice',    'struct Device *',
  123.   'DataTypesBase',    'struct Library *',
  124.   'DiskBase',        'struct Node *',
  125.   'DiskfontBase',    'struct Library *',
  126.   'DOSBase',        'struct DosLibrary *',
  127.   'DTClassBase',    'struct Library *',
  128.   'SysBase',        'struct ExecBase *',
  129.   'GadToolsBase',    'struct Library *',
  130.   'IconBase',        'struct Library *',
  131.   'IFFParseBase',    'struct Library *',
  132.   'InputBase',        'struct Device *',
  133.   'KeymapBase',        'struct Library *',
  134.   'LayersBase',        'struct Library *',
  135.   'LowLevelBase',    'struct Library *',
  136.   'MathBase',        'struct Library *',
  137.   'MathIeeeDoubBasBase'    ,'struct MathIEEEBase *',
  138.   'MathIeeeDoubTransBase','struct MathIEEEBase *',
  139.   'MathIeeeSingBasBase'    ,'struct MathIEEEBase *',
  140.   'MathIeeeSingTransBase','struct MathIEEEBase *',
  141.   'MathTransBase',    'struct Library *',
  142.   'MiscBase',        'struct Node *',
  143.   'NVBase',        'struct Library *',
  144.   'PotgoBase',        'struct Node *',
  145.   'RamdriveDevice',    'struct Device *',
  146.   'RexxSysBase',    'struct Library *',
  147.   'TimerBase',        'struct Device *',
  148.   'TranslatorBase',    'struct Library *',
  149.   'WorkbenchBase',    'struct Library *',
  150.  
  151.   'XpkBase',        'struct Library *',
  152.   'XpkSubBase',        'struct Library *',
  153.   'SocketBase',        'struct Library *',
  154. );
  155.  
  156. ($lib_base_type = $base_types{$lib_base_name}) || 
  157.   ($lib_base_type = "struct " . $lib_base_name . " *");
  158.  
  159. # convert arg_name_tab and arg_type_tab into arg_tab. This is rather tricky...
  160.  
  161. foreach $func (sort keys(%arg_name_tab)) {
  162.   $_=$arg_name_tab{$func};
  163.   if ($_ eq "" || /^\s*void\s*/i)
  164.     {
  165.       # no arguments given, or just void or VOID
  166.       $arg_tab{$func} = "";
  167.       next;
  168.     }
  169.   else
  170.     {
  171.       # unpack arguments into array @names
  172.       @names = split(/,/, $arg_name_tab{$func});
  173.       # NOTE: this trick fails if someone specifies full prototypes for
  174.       #       function pointers, ie. (.., (*func)(int, int, int), ...).
  175.       #       Currently just one function in graphics.h does this, so it's
  176.       #       not worth the hassle to do it `right'.
  177.       @types = split(/,/, $arg_type_tab{$func});
  178.       # @types may still contain argument names, if they were specified
  179.       # in the proto file. This is a tricky task, separate the optional
  180.       # argument name...
  181.       foreach $i (0 .. $#types) {
  182.         @words = split(/ /,$types[$i]);
  183.         $wi=$#words;
  184.     word_loop: while ($wi > 0)
  185.       {
  186.             if ($words[$wi] =~ /[\(\)]/ && !($words[$wi - 1] =~ /[\(\)]/))
  187.               {
  188.         last word_loop;
  189.           }
  190.         elsif (!($words[$wi] =~ /[\(\)]/))
  191.           {
  192.             last word_loop;
  193.           }
  194.         $wi--;
  195.       }
  196.     # here come heuristics... (do we have a name to write over or 
  197.     # do we have to append a new element?)
  198.     if ($words[$wi] eq "int" ||
  199.         $words[$wi] eq "long" ||
  200.         $words[$wi] eq "short" ||
  201.         $words[$wi] eq "char" ||
  202.         $words[$wi] eq "*")
  203.       {
  204.         $wi++;
  205.       }
  206.     ($words[$wi] =~ s/(\W*)(\w+)(.*)/\1$names[$i]\3/) ||
  207.       ($words[$wi] = $names[$i]);
  208.     $types[$i] = "@words";
  209.       }
  210.       $arg_tab{$func} = join("|", @types);
  211.     }
  212. }
  213.  
  214. # this table maps functions that have an alternate stdarg-companion
  215. # it would probably be better (and more generic) to do this mapping with
  216. # some rather weird regular expressions. However, since almost every header
  217. # file chose a different set of naming `rules' how to deduce the stdarg-name
  218. # from the plain name, it would probably not be much better for the future,
  219. # there's no sign that this deliberate creativity in inventing new naming
  220. # conventions should stop....
  221.  
  222. %stdarg_names = (
  223.   # amigaguide.library
  224.   'OpenAmigaGuideA',        'OpenAmigaGuide',
  225.   'OpenAmigaGuideAsyncA',    'OpenAmigaGuideAsync',
  226.   'SetAmigaGuideContextA',    'SetAmigaGuideContext',
  227.   'SendAmigaGuideContextA',    'SendAmigaGuideContext',
  228.   'SendAmigaGuideCmdA',        'SendAmigaGuideCmd',
  229.   'SetAmigaGuideAttrsA',    'SetAmigaGuideAttrs',
  230.   'AddAmigaGuideHostA',        'AddAmigaGuideHost',
  231.   'RemoveAmigaGuideHostA',    'RemoveAmigaGuideHost',
  232.   # asl.library
  233.   'AllocAslRequest',        'AllocAslRequestTags',
  234.   'AslRequest',            'AslRequestTags',
  235.   # bullet.library
  236.   'SetInfoA',            'SetInfo',
  237.   'ObtainInfoA',        'ObtainInfo',
  238.   'ReleaseInfoA',        'ReleaseInfo',
  239.   # datatypes.library
  240.   'ObtainDataTypeA',        'ObtainDataType',
  241.   'NewDTObjectA',        'NewDTObject',
  242.   'SetDTAttrsA',        'SetDTAttrs',
  243.   'GetDTAttrsA',        'GetDTAttrs',
  244.   'RefreshDTObjectsA',        'RefreshDTObjects',
  245.   'DoDTMethodA',        'DoDTMethod',
  246.   'PrintDTObjectA',        'PrintDTObject',
  247.   # dos.library
  248.   'AllocDosObject',        'AllocDosObjectTags',
  249.   'VFWritef',            'FWritef',
  250.   'VFPrintf',            'FPrintf',
  251.   'CreateNewProc',        'CreateNewProcTags',
  252.   'SystemTagList',        'SystemTags',
  253.   'NewLoadSeg',            'NewLoadSegTags',
  254.   'VPrintf',            'Printf',
  255.   # gadtools.library
  256.   'CreateGadgetA',        'CreateGadget',
  257.   'GT_SetGadgetAttrsA',        'GT_SetGadgetAttrs',
  258.   'CreateMenusA',        'CreateMenus',
  259.   'LayoutMenuItemsA',        'LayoutMenuItems',
  260.   'LayoutMenusA',        'LayoutMenus',
  261.   'DrawBevelBoxA',        'DrawBevelBox',
  262.   'GetVisualInfoA',        'GetVisualInfo',
  263.   'GT_GetGadgetAttrsA',        'GT_GetGadgetAttrs',
  264.   # graphics.library
  265.   'VideoControl',        'VideoControlTags',    # own creation ;-)
  266.   'WeighTAMatch',        'WeighTAMatchTags',    # own creation ;-)
  267.   'ExtendFont',            'ExtendFontTags',    # own creation ;-)
  268.   'ObtainBestPenA',        'ObtainBestPen',
  269.   'GetExtSpriteA',        'GetExtSprite',
  270.   'AllocSpriteDataA',        'AllocSpriteData',
  271.   'ChangeExtSpriteA',        'ChangeExtSprite',
  272.   'SetRPAttrsA',        'SetRPAttrs',
  273.   'GetRPAttrsA',        'GetRPAttrs',
  274.   'BestModeIDA',        'BestModeID',
  275.   # intuition.library
  276.   'EasyRequestArgs',        'EasyRequest',
  277.   'BuildEasyRequestArgs',    'BuildEasyRequest',
  278.   'OpenWindowTagList',        'OpenWindowTags',
  279.   'OpenScreenTagList',        'OpenScreenTags',
  280.   'NewObjectA',            'NewObject',
  281.   'SetAttrsA',            'SetAttrs',
  282.   'SetGadgetAttrsA',        'SetGadgetAttrs',
  283.   'DoGadgetMethodA',        'DoGadgetMethod',
  284.   'SetWindowPointerA',        'SetWindowPointer',
  285.   # locale.library
  286.   'OpenCatalogA',        'OpenCatalog',
  287.   # lowlevel.library
  288.   'SystemControlA',        'SystemControl',
  289.   'SetJoyPortAttrsA',        'SetJoyPortAttrs',
  290.   # realtime.library
  291.   'CreatePlayerA',        'CreatePlayer',
  292.   'SetPlayerAttrsA',        'SetPlayerAttrs',
  293.   'GetPlayerAttrsA',        'GetPlayerAttrs',
  294.   # utility.library
  295.   'AllocNamedObjectA',        'AllocNamedObject',
  296.   # workbench.library
  297.   'AddAppWindowA',        'AddAppWindow',
  298.   'AddAppIconA',        'AddAppIcon',
  299.   'AddAppMenuItemA',        'AddAppMenuItem',
  300. );
  301.  
  302.  
  303. # these are aliases for some functions, that for what reason ever got two
  304. # names for the same entry point. This is a dos.library pecularity..
  305. # the list is symmetric, since it's random which of the two names actually
  306. # appears in the fd file, and is thus generated inline...
  307. %aliased_names = (
  308.   'AllocDosObjectTagList',    'AllocDosObject',
  309.   'AllocDosObject',        'AllocDosObjectTagList',
  310.   'CreateNewProcTagList',    'CreateNewProc',
  311.   'CreateNewProc',        'CreateNewProcTagList',
  312.   'SystemTagList',        'System',
  313.   'System',            'SystemTagList',
  314.   'NewLoadSegTagList',        'NewLoadSeg',
  315.   'NewLoadSeg',            'NewLoadSegTagList',
  316. );
  317.  
  318. # now output the real file
  319.  
  320. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($def = $2 . "_H");
  321. $def =~ s/_protos//;
  322. $def =~ tr/[a-z]/[A-Z]/;
  323.  
  324. print "#ifndef _INLINE_$def\n#define _INLINE_$def\n\n";
  325.  
  326. print "#include <sys/cdefs.h>\n";
  327. print "#include <inline/stubs.h>\n";
  328.  
  329. # this is for C++ support, it does `extern "C" {' if __cplusplus is defined
  330. print "\n__BEGIN_DECLS\n\n";
  331.  
  332. print "#ifndef BASE_EXT_DECL\n";
  333. print "#define BASE_EXT_DECL\n";
  334. print "#define BASE_EXT_DECL0 extern $lib_base_type $lib_base_name;\n";
  335. print "#endif\n";
  336.  
  337. print "#ifndef BASE_PAR_DECL\n";
  338. print "#define BASE_PAR_DECL\n";
  339. print "#define BASE_PAR_DECL0 void\n";
  340. print "#endif\n";
  341.  
  342. print "#ifndef BASE_NAME\n";
  343. print "#define BASE_NAME $lib_base_name\n";
  344. print "#endif\n\n";
  345.  
  346. print "BASE_EXT_DECL0\n\n";
  347.  
  348. foreach $func (sort keys(%result_tab)) {
  349.   # this happens if the clib/ file defines functions that only exist in amiga.lib
  350.   next if $bias_tab{$func} == 0;
  351.  
  352.   print "extern __inline ",$result_tab{$func},"\n";
  353.  
  354.   if ($arg_tab{$func} eq "")
  355.     {
  356.       print $func," (BASE_PAR_DECL0)\n{\n";
  357.     }
  358.   else
  359.     {
  360.       print $func," (BASE_PAR_DECL ",join(",", split(/\|/, $arg_tab{$func})),")\n{\n";
  361.     }
  362.   print "  BASE_EXT_DECL\n";
  363.   if (!($result_tab{$func} =~ /^\s*void\s*$/i))
  364.     {
  365.       print "  register $result_tab{$func} _res $result_tab_end{$func} __asm(\"d0\");\n";
  366.     }
  367.   print "  register ${lib_base_type}a6 __asm(\"a6\") = BASE_NAME;\n";
  368.   @args = split(/\|/, $arg_tab{$func});
  369.   @names = split(/,/, $arg_name_tab{$func});
  370.   @regs = split(/[\/,]/, $reg_tab{$func});
  371.   $warn_a4a5 = 0;
  372.   $owe_nl = 0;
  373.  
  374.   if ($#args >= 0)
  375.     {
  376.       # map the fd given register list to the arguments. If there wasn't 
  377.       # DOUBLE/double, then this mapping would be 1:1, but a double variable
  378.       # is specified as taking d0/d1 in the fd file, while gcc only wants to
  379.       # see the d0.
  380.  
  381.       $i = 0;
  382.       $ri = 0;
  383.       @reg_args = ();
  384.       while ($i <= $#args)
  385.         {
  386.           $reg_args[$i] = $regs[$ri];
  387.       # double, but not double pointers, skip one register
  388.       if ($args[$i] =~ /double[^\*]*$/i)
  389.         {
  390.           $ri+=2;
  391.         }
  392.       else
  393.         {
  394.           $ri++;
  395.         }
  396.       $decl = $args[$i];
  397.       $decl =~ s/(\W)$names[$i](\W?)/\1$reg_args[$i]\2/;
  398.           print "  register $decl __asm(\"$reg_args[$i]\") = $names[$i];\n";
  399.           $i++;
  400.         }
  401.     }
  402.   printf "  __asm __volatile (\"jsr a6@(-0x%x)\"\n", $bias_tab{$func};
  403.   if ($result_tab{$func} =~ /^\s*void\s*$/i)
  404.     {
  405.       print "  : /* no output */\n";
  406.     }
  407.   else
  408.     {
  409.       print "  : \"=r\" (_res)\n";
  410.     }
  411.   if ($#args == -1)
  412.     {
  413.       print "  : \"r\" (a6)\n";
  414.     }
  415.   else
  416.     {
  417.       print "  : \"r\" (a6)";
  418.       foreach $r (@reg_args) {
  419.         print ", \"r\" ($r)";
  420.       }
  421.       print "\n";
  422.     }
  423.  
  424.   @clobb=("d0", "d1", "a0", "a1");
  425.   push (@clobb, @regs);
  426.   @clobb = sort(@clobb);
  427.   print "  : ";
  428.   # specify "memory" in each call, since each call is a subroutine call to some
  429.   # space which may do things we don't know ;-) Besides, this shouldn't hurt
  430.   # performance, and if it does, I'd need specific information HOW it hurts,
  431.   # so "memory" could be disabled in just those cases.
  432.   foreach $i (0 .. $#clobb) {
  433.     (($clobb[$i] ne $clobb[$i+1]) && ($i != $#clobb) && (print "\"$clobb[$i]\",")) ||
  434.     ($i == $#clobb && (print "\"$clobb[$i]\", \"memory\");\n"));
  435.   }
  436.  
  437. # no longer necessary, since gcc now supports `register' "memory" to denote
  438. # that memory is clobbered by indirection on registers
  439. #
  440. #  # hack.. for all arguments addressed via address registers, fake a value change
  441.   foreach $i (0 .. $#regs) {
  442. #    ($regs[$i] =~ /a[0-5]/) && 
  443. #     (print "  *(char *)$regs[$i] = *(char *)$regs[$i];") && ($owe_nl= 1);
  444.     ($regs[$i] =~ /a[45]/) && ($warn_a4a5 = 1);
  445.   }
  446.   print STDERR "Warning: $func uses a4 or a5, add code to save/restore them!\n"
  447.     if $warn_a4a5;
  448.  
  449.   print "\n" if ($owe_nl);
  450.   print "  return _res;\n" if (!($result_tab{$func} =~ /^\s*void\s*$/i));
  451.   print "}\n";
  452.   
  453.   if ($stdarg_names{$func})
  454.     {
  455.       print "#ifndef NO_INLINE_STDARG\n";
  456.       print "#define $stdarg_names{$func}(";
  457.       foreach $i (0 .. $#args-1) {
  458.     print "a$i, ";
  459.       }
  460.       print "tags...) \\\n";
  461.       print "  ({ struct TagItem _tags[] = { tags }; $func (";
  462.       foreach $i (0 .. $#args-1) {
  463.     print "(a$i), ";
  464.       }
  465.       print "_tags); })\n";
  466.       print "#endif /* not NO_INLINE_STDARG */\n";
  467.     }
  468.   
  469.   if ($aliased_names{$func})
  470.     {
  471.       # provide arguments to the macro, should reduce expansion of the macro
  472.       # at the wrong place..
  473.       print "#define $aliased_names{$func}(";
  474.       foreach $i (0 .. $#args-1) {
  475.     print "a$i, ";
  476.       }
  477.       print "a$#args) $func (";
  478.       foreach $i (0 .. $#args-1) {
  479.     print "(a$i), ";
  480.       }
  481.       print "(a$#args))\n";
  482.     }
  483. }
  484.  
  485. print "\n#undef BASE_EXT_DECL\n";
  486. print "#undef BASE_EXT_DECL0\n";
  487. print "#undef BASE_PAR_DECL\n";
  488. print "#undef BASE_PAR_DECL0\n";
  489. print "#undef BASE_NAME\n";
  490.  
  491. print "\n__END_DECLS\n\n";
  492.  
  493. print "#endif /* _INLINE_$def */\n";
  494.